home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / fortran / f2c_src.zip / F2C / LIBI77 / XWSNE.C < prev   
C/C++ Source or Header  |  1991-06-10  |  935b  |  54 lines
  1. #include "f2c.h"
  2. #include "fio.h"
  3. #include "lio.h"
  4. #include "fmt.h"
  5.  
  6. x_wsne(a)
  7.  cilist *a;
  8. {
  9.     Namelist *nl;
  10.     char *s;
  11.     Vardesc *v, **vd, **vde;
  12.     ftnint *number, type;
  13.     ftnlen *dims;
  14.     ftnlen size;
  15.     static ftnint one = 1;
  16.     extern ftnlen typesize[];
  17.  
  18.     nl = (Namelist *)a->cifmt;
  19.     PUT('&');
  20.     for(s = nl->name; *s; s++)
  21.         PUT(*s);
  22.     PUT(' ');
  23.     vd = nl->vars;
  24.     vde = vd + nl->nvars;
  25.     while(vd < vde) {
  26.         v = *vd++;
  27.         s = v->name;
  28.         if (recpos+strlen(s)+2 >= L_len)
  29.             (*donewrec)();
  30.         while(*s)
  31.             PUT(*s++);
  32.         PUT(' ');
  33.         PUT('=');
  34.         number = (dims = v->dims) ? dims + 1 : &one;
  35.         type = v->type;
  36.         if (type < 0) {
  37.             size = -type;
  38.             type = TYCHAR;
  39.             }
  40.         else
  41.             size = typesize[type];
  42.         l_write(number, v->addr, size, type);
  43.         if (vd < vde) {
  44.             if (recpos+2 >= L_len)
  45.                 (*donewrec)();
  46.             PUT(',');
  47.             PUT(' ');
  48.             }
  49.         else if (recpos+1 >= L_len)
  50.             (*donewrec)();
  51.         }
  52.     PUT('/');
  53.     }
  54.